home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / examples / lexyacc / Parser.grm < prev    next >
Encoding:
Text File  |  1997-08-18  |  3.4 KB  |  100 lines  |  [TEXT/R*ch]
  1. %{
  2. open Data;
  3.  
  4. fun mkintop2 opr (Int n1, Int n2)  = Int (opr (n1, n2))
  5. fun mkboolop2 opr (Int n1, Int n2) = Int (opr (n1, n2))
  6. fun mkrelop2 opr (Int n1, Int n2)  = Int (if opr (n1, n2) then 1 else 0)
  7.  
  8. val lor  : int * int -> int = op *
  9. val land : int * int -> int = op +
  10. val lneg = fn b => if b = 0 then 1 else 0
  11. %}
  12.  
  13. %token <int> INT
  14. %token <string> NAME
  15. %token PLUS MINUS TIMES DIV MOD
  16. %token EQ NE LT LE GE GT
  17. %token AMPERSAND BAR
  18. %token LAMBDA DOT SEMI COMMA DASHARROW
  19. %token CASE ELSE END IF IN LET LETREC OF PACK THEN
  20. %token LBRACE RBRACE LPAR RPAR
  21. %token EOF
  22. %token JUNK
  23.  
  24. %left AMPERSAND            /* lowest precedence */
  25. %left BAR                       
  26. %nonassoc EQ NE LT LE GE GT
  27. %left PLUS MINUS                
  28. %left TIMES DIV MOD            /* highest precedence  */
  29.  
  30. %start Main
  31. %type <Data.sourceexpr> Main Expr SExpr AppExpr AExpr
  32. %type <Data.sourceexpr list> Exprs
  33. %type <string * Data.sourceexpr> Defn
  34. %type <(string * Data.sourceexpr) list> Defns
  35. %type <int * string list * Data.sourceexpr> Alt
  36. %type <(int * string list * Data.sourceexpr) list> Alts
  37. %type <string list> Vars 
  38.  
  39. %%
  40.  
  41. Main:
  42.     Expr EOF                            { $1 }
  43. ;
  44. Expr:
  45.     LET Defns IN Expr                   { LetS($2, $4) }
  46.   | LETREC Defns IN Expr                { LetrecS($2, $4) }
  47.   | CASE Expr OF Alts END               { CaseS($2, $4) }
  48.   | IF Expr THEN Expr ELSE Expr         { IfS($2, $4, $6) }
  49.   | LAMBDA NAME DOT Expr                { LamS($2, $4) }
  50.   | SExpr                               { $1 }
  51. ;
  52. SExpr:
  53.     AppExpr                             { $1 }
  54.   | SExpr DIV SExpr                     { Op2S(mkintop2 (op div), $1, $3) }
  55.   | SExpr MOD SExpr                     { Op2S(mkintop2 (op mod), $1, $3) } 
  56.   | SExpr TIMES SExpr                   { Op2S(mkintop2 (op *  ), $1, $3) }  
  57.   | SExpr PLUS SExpr                    { Op2S(mkintop2 (op +  ), $1, $3) }  
  58.   | SExpr MINUS SExpr                   { Op2S(mkintop2 (op -  ), $1, $3) }  
  59.   | SExpr EQ SExpr                      { Op2S(mkrelop2 (op =  ), $1, $3) }  
  60.   | SExpr NE SExpr                      { Op2S(mkrelop2 (op <> ), $1, $3) }    
  61.   | SExpr LT SExpr                      { Op2S(mkrelop2 (op <  ), $1, $3) }   
  62.   | SExpr LE SExpr                      { Op2S(mkrelop2 (op <= ), $1, $3) }   
  63.   | SExpr GT SExpr                      { Op2S(mkrelop2 (op >  ), $1, $3) }   
  64.   | SExpr GE SExpr                      { Op2S(mkrelop2 (op >= ), $1, $3) }   
  65.   | SExpr AMPERSAND SExpr               { Op2S(mkboolop2 land, $1, $3) }
  66.   | SExpr BAR SExpr                     { Op2S(mkboolop2 lor, $1, $3)  }
  67. ;
  68. AppExpr:
  69.     AExpr                               { $1 }
  70.   | AppExpr AExpr                       { AppS($1, $2) }  
  71. ;
  72. AExpr:
  73.     NAME                                { VarS $1 }
  74.   | INT                                 { CstS (Int $1) }
  75.   | PACK LBRACE INT Exprs RBRACE        { ConS($3, $4) }
  76.   | LPAR Expr RPAR                      { $2 }
  77. ;
  78. Defns:
  79.     Defn                                { [ $1 ] }   
  80.   | Defn SEMI Defns                     { $1 :: $3 }
  81. ;
  82. Defn:
  83.     NAME EQ Expr                        { ($1, $3) }
  84. ;
  85. Alts:
  86.     Alt                                 { [ $1 ] }
  87.   | Alt SEMI Alts                       { $1 :: $3 }
  88. ;
  89. Alt:
  90.     LT INT GT Vars DASHARROW Expr       { ($2, $4, $6) }
  91. ;
  92. Vars:
  93.     /* empty */                         { [ ] }
  94.   | NAME Vars                           { $1 :: $2 }
  95. ;
  96. Exprs:
  97.     /* empty */                         { [ ] }
  98.   | COMMA Expr Exprs                    { $2 :: $3 }
  99. ;
  100.